home *** CD-ROM | disk | FTP | other *** search
/ Aminet 37 / Aminet 37 (2000)(Schatztruhe)[!][Jun 2000].iso / Aminet / dev / basic / Mildred.lha / lha / CardTest.lha / ILBMviewer2.ascii < prev    next >
Encoding:
Text File  |  1999-03-07  |  12.2 KB  |  396 lines
  1. WBStartup
  2.  
  3. .Variables
  4.  
  5. CPUminimum.b=Processor
  6. PrefDisplayDepth.w=8
  7. *ScrVP._ViewPort=0
  8. IsAGA.b=False
  9. Multitasking.b=True ; Default
  10. Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)
  11.  
  12. .Prefs
  13.  
  14. PrefDisplayID.l=$0 ; Default (unspecified, as it may possibly retarget (doublescan etc))
  15. ;PrefDisplayID.l=$21000 ; AGA Lores PAL 320x256 non-laced single-scan 50Hz
  16. ;PrefDisplayID.l=$A1000 ; AGA Lores DoublePAL 384x275 non-laced double-scan 48Hz
  17. ;PrefDisplayID.l=$89000 ; AGA Lores Super72 384x290 non-laced single-scan 71Hz
  18. ;PrefDisplayID.l=$11000 ; AGA Lores NTSC 320x200 non-laced single-scan 60Hz
  19. ;PrefDisplayID.l=$39000 ; AGA Lores Multiscan 320x240 double-scan 58Hz
  20. ;PrefDisplayID.l=$59000 ; AGA Lores HighGFX 512x250 non-laced single-scan 54Hz
  21. ;PrefDisplayID.l=$69000 ; AGA Lores Euro72 320x200 non-laced double-scan 69Hz
  22. ;PrefDisplayID.l=$91000 ; AGA Lores DoubleNTSC 384x227 non-laced double-scan 58Hz
  23. ;PrefDisplayID.l=$29004 ; AGA PAL 640x400 Hires laced single-scan 50Hz
  24. ;PrefDisplayID.l=$19004 ; AGA NTSC 640x400 Hires laced single-scan 60Hz
  25. ;PrefDisplayID.l=$39024 ; AGA Multiscan 640x400 Hires non-laced single-scan 58Hz
  26. ;PrefDisplayID.l=$69024 ; AGA Euro72 640x400 Hires non-laced single-scan 69Hz
  27. ;PrefDisplayID.l=$A9004 ; AGA DoublePAL 640x400 Hires non-laced double-scan 48Hz
  28. ;PrefDisplayID.l=$99004 ; AGA DoubleNTSC 640x400 Hires non-laced double-scan 58Hz
  29. PrefDisplayWidth.w=320
  30. PrefDisplayHeight.w=240
  31. PrefDisplayBuffering.b=1 ; 1..3
  32. ;If Joyb(0)=0 AND Joyb(1)=0 Then Goto PrefsSkip
  33.  
  34. #DTAG_DISP=$80000000
  35. #DTAG_DIMS=$80001000
  36. #DTAG_MNTR=$80002000
  37. #DTAG_NAME=$80003000
  38.  
  39. NEWTYPE.SMode
  40.   DID.l
  41.   DWidth.l
  42.   DHeight.l
  43.   DDepth.w
  44.   DType.w
  45. End NEWTYPE
  46.  
  47. DEFTYPE.Hook myhook ; The hook for ASL tag as &myhook
  48. myhook\h_Entry=?hook
  49. MOVE.l a5,globalbase
  50. funcret.l=0
  51.  
  52. Dim SMRtags.TagItem(17)
  53. SMRtags(0)\ti_Tag=#ASLSM_InitialLeftEdge,160
  54. SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0
  55. SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300
  56. SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,600
  57. SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000
  58. SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8
  59. SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth
  60. SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight
  61. SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1
  62. SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1
  63. SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350
  64. SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50
  65. SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0
  66. SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,1
  67. SMRtags(14)\ti_Tag=#ASLSM_DoWidth,1
  68. SMRtags(15)\ti_Tag=#ASLSM_DoHeight,1
  69. SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook
  70. SMRtags(17)\ti_Tag=#TAG_DONE,0
  71.  
  72. *sreq.SMode=0
  73. *sreq=AllocAslRequest_(2,&SMRtags(0)\ti_Tag)
  74. ok.b=AslRequest_(*sreq,&SMRtags(0)\ti_Tag)
  75.  
  76. If ok<>0
  77.   PrefDisplayID.l=*sreq\DID
  78.   PrefDisplayWidth.w=*sreq\DWidth
  79.   PrefDisplayHeight.w=*sreq\DHeight
  80. EndIf
  81. If (*sreq) Then FreeAslRequest_(*sreq)
  82.  
  83. Goto PrefsSkip
  84.  
  85. ;*************************************************************************
  86. ; This is the statement that the hook will call.  Put the label before
  87. ; the statement you want to jump to.
  88. Runerrsoff
  89. .hook_jump:
  90. Statement hook{*dahook.Hook, modeID.l, *smr.ScreenModeRequester}
  91.   ; We're inside the hook, and supposedly we should be able to do whatever
  92.   ; we want.
  93.   ; Filter modeID's here
  94.   SHARED funcret.l
  95.   DEFTYPE.DisplayInfo DisInfoBuf
  96.   DEFTYPE.DimensionInfo DimInfoBuf
  97.   DEFTYPE.MonitorInfo MonInfoBuf
  98.   DEFTYPE.NameInfo NamInfoBuf
  99.   ;Refer to Includes/Graphics/DisplayInfo.h or view newtypes
  100.   IDhandle.l=FindDisplayInfo_(modeID)
  101.   GetDisplayInfoData_ IDhandle,&DisInfoBuf,SizeOf.DisplayInfo,#DTAG_DISP,0
  102.   GetDisplayInfoData_ IDhandle,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  103.   GetDisplayInfoData_ IDhandle,&MonInfoBuf,SizeOf.MonitorInfo,#DTAG_MNTR,0
  104.   GetDisplayInfoData_ IDhandle,&NamInfoBuf,SizeOf.NameInfo,#DTAG_NAME,0
  105.   ;Do tests. True=Mode is valid, False=mode is invalid.
  106.   If DimInfoBuf\MaxDepth<>8
  107.     ;No true-colour modes, only 8-bit
  108.     funcret=False
  109.   Else
  110.     funcret=True
  111.   EndIf
  112. End Statement
  113.  
  114. ;**********************
  115. ; Hook
  116. Macro goto_hook
  117.   JSR `1+6
  118. End Macro
  119.  
  120. globalbase: Dc.l 0
  121.  
  122. hook: ;This hook is called by the filter hook callback from screenmode requester, per item
  123. ; Store registers
  124. MOVEM.l   d1-d7/a0-a6,-(a7) ; Not d0!
  125.  
  126. ; Put parameters into dregs ready for a statement
  127. MOVE.l    a0,d0
  128. MOVE.l    a1,d1
  129. MOVE.l    a2,d2
  130.  
  131. ; Get global variable base
  132. MOVE.l    globalbase,a5
  133.  
  134. ; Goto hook statement
  135. !goto_hook{hook_jump}
  136.  
  137. GetReg d0,funcret ; return accept/discard
  138.  
  139. ; Restore registers
  140. MOVEM.l   (a7)+,d1-d7/a0-a6 ; Not d0!
  141.  
  142. RTS
  143. ;**********************
  144.  
  145. Runerrson
  146. PrefsSkip
  147.  
  148. .Display
  149.  
  150. Statement Permit{}
  151. ;Permit multitasking, only if it is globally intended
  152.   SHARED Multitasking.b
  153.   If Multitasking Then Permit_
  154. End Statement
  155.  
  156. Statement Forbid{}
  157. ;Disable multitasking, if it isn't globally intended
  158.   SHARED Multitasking.b
  159.   If Multitasking Then Forbid_
  160. End Statement
  161.  
  162. Statement Multitasking{State.b}
  163. ;Toggle global multitasking on or off.
  164.   SHARED Multitasking.b
  165.   If State
  166.     If Multitasking=False Then Permit_
  167.   Else
  168.     If Multitasking Then Forbid_
  169.   EndIf
  170.   Multitasking=State
  171. End Statement
  172.  
  173. Function.b InitDisplay{Title$}
  174. ;Creates a display
  175. ;Title$=The screen title (not displayed)
  176.   SHARED PrefDisplayHeight.w,PrefDisplayID.l,PrefDisplayBuffering.b,*ScrVP._ViewPort,IsAGA.b
  177.   SHARED PrefDisplayLeft.w,PrefDisplayTop.w
  178.   SHARED PrefDisplayDepth.w,PrefDisplayWidth.w,CPUminimum.b
  179.   SHARED PlanarBuf()
  180.   ;Open a test screen first to a) test for AGA or GFX-Card, and b) because the dimensions might be
  181.   ;too large to open a chipram screen, and the dimensions for AGA have not yet been reduced to within limits
  182.   Dim ScrTags.TagItem(13)
  183.   Rect.Rectangle\MinX=0,0,320,240 ; For test
  184.   ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
  185.   ScrTags(1)\ti_Tag=#SA_Height,240; For test
  186.   ScrTags(2)\ti_Tag=#SA_Depth,PrefDisplayDepth
  187.   ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  188.   ScrTags(4)\ti_Tag=#SA_Type,$F
  189.   ScrTags(5)\ti_Tag=#SA_Quiet,True
  190.   ScrTags(6)\ti_Tag=#SA_ShowTitle,False
  191.   ScrTags(7)\ti_Tag=#SA_Behind,True
  192.   ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
  193.   ScrTags(9)\ti_Tag=#SA_Exclusive,True
  194.   ScrTags(10)\ti_Tag=#SA_Draggable,False
  195.   ScrTags(11)\ti_Tag=#SA_AutoScroll,True
  196.   ScrTags(12)\ti_Tag=#TAG_DONE,0
  197.   ScrTags(13)\ti_Tag=#TAG_DONE,0
  198.   UsedChip.l=(320 LSR 3)*PrefDisplayDepth*240 ; With test params
  199.   FreeChip.l=AvailMem_(#MEMF_CHIP)
  200.   Forbid{}
  201.   If ScreenTags(0,Title$,&ScrTags(0))<>0 ; Test for GFX-Card or AGA
  202.     NowChip.l=AvailMem_(#MEMF_CHIP)
  203.     Permit{}
  204.     If FreeChip-NowChip<UsedChip
  205.       ; Graphics card screen
  206.       IsAGA=False
  207.       PrefDisplayWidth AND $FFF0 ; For gfx-cards, width to nearest 16
  208.       ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
  209.       Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
  210.       ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
  211.       ScrTags(8)\ti_Tag=#SA_DClip,&Rect
  212.       VWait 5 ; seems to be necessary (safer)
  213.       Free Screen 0
  214.       VWait 5 ; just to be on the safe side
  215.       If ScreenTags(0,Title$,&ScrTags(0))<>0
  216.         For Loop.w=0 To PrefDisplayBuffering-1
  217.           If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
  218. If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
  219.           Menus Off
  220.           ScreensBitMap 0,Loop
  221.           *TmpBmp.bitmap=Addr BitMap(Loop)
  222.           Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
  223.           For DLoop.w=0 To PrefDisplayDepth-1
  224.             *TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
  225.           Next DLoop
  226.         Next Loop
  227.       Else
  228.         Function Return False
  229.       EndIf
  230.     Else
  231.       ; AGA screen
  232.       IsAGA=True
  233.       PrefDisplayWidth AND $FFC0 ; For AGA, width to nearest 64
  234.       ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
  235.       Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
  236.       ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
  237.       ScrTags(8)\ti_Tag=#SA_DClip,&Rect
  238.       ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  239.       Forbid{}
  240.       VWait 5 ; seems to be necessary (safer)
  241.       Free Screen 0
  242.       For Loop.w=0 To PrefDisplayBuffering-1
  243.         If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
  244.         If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
  245.           Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chip bitmap
  246.           Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
  247.           If Memory<>0
  248.             CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,PrefDisplayDepth,Memory
  249.             If Loop=0
  250.               ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
  251.               If ScreenTags(0,Title$,&ScrTags(0))=0
  252.                 Permit{}
  253.                 Function Return False
  254.               EndIf
  255.             EndIf
  256.             If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
  257.             Menus Off
  258.           Else
  259.             Permit{}
  260.             Function Return False
  261.           EndIf
  262.         Else
  263.           Permit{}
  264.           Function Return False
  265.         EndIf
  266.         PlanarBuf(Loop)=Memory
  267.       Next Loop
  268.       Permit{}
  269.     EndIf
  270.     DEFTYPE.DimensionInfo DimInfoBuf
  271.     GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  272.     PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
  273.     PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
  274.     *Scr._Screen=Peek.l(Addr Screen(0))
  275.     *ScrVP=ViewPort(0)
  276.     *ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
  277.     ScrollVPort_ *ScrVP
  278.     RethinkDisplay_
  279.     Use Palette 0
  280.     Menus Off
  281.     If *ScrVP\DHeight<>PrefDisplayHeight
  282.       Forbid{}
  283.       *Scr\Height=PrefDisplayHeight ; Enforce y clipping
  284.       Permit{}
  285.     EndIf
  286.     ScreenToFront_ *Scr
  287.     Function Return True
  288.   Else
  289.     Permit{}
  290.     Function Return False
  291.   EndIf
  292. End Function
  293.  
  294. .Main
  295.  
  296. DEFTYPE.w
  297.  
  298. MaxLen ASLfile$=256
  299. MaxLen ASLpath$=256
  300. ASLpath$="Data:Pictures/IFF"
  301. WbToScreen 0
  302. Pic$=ASLFileRequest$("Choose an ILBM picture)",ASLpath$,ASLfile$)
  303. ILBMInfo Pic$
  304. ILBMWid=ILBMWidth
  305. If ILBMWid MOD 16<>0 Then ILBMWid=(ILBMWid+16) AND $FFFFFFF0
  306. ILBMWid=Max(ILBMWid,320)
  307. ILBMHig=ILBMHeight
  308. InitBank 0,ILBMWid*ILBMHig,$0
  309. CludgeBitMap 4,ILBMWid,ILBMHig,8,Bank(0)
  310. CPUCls 4
  311. LoadBitMap 4,Pic$,0
  312. MBitmap 0,ILBMWid,ILBMHig
  313. MPlanar16ToBitmap 0,Bank(0)
  314. If InitDisplay{"Game"}=False Then Goto Finish
  315. ShowPalette 0
  316. Multitasking{On}
  317. buf.b=0
  318. its.l=0
  319. xmult.q=(ILBMWid-PrefDisplayWidth)/PrefDisplayWidth
  320. ymult.q=(ILBMHig-PrefDisplayHeight)/PrefDisplayHeight
  321. LandX.w=0
  322. LandY.w=0
  323. Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight,ILBMWid,CPUminimum,PrefDisplayWidth,PrefDisplayHeight
  324.  
  325. MCPU CPUminimum
  326. If ExecVersion<40
  327.   If MBitmap(1,PrefDisplayWidth,PrefDisplayHeight+1)=0 Then Goto Finish
  328. EndIf
  329. *Ras.RasInfo=*ScrVP\RasInfo
  330. *RP._RastPort=RastPort(0)
  331. MCludgeBitmap 10,PrefDisplayWidth,PrefDisplayHeight,*RP\_BitMap\Planes
  332. ResetTimer
  333. While Joyb(0)<>1 AND Joyb(1)=0
  334.  
  335.   If Joyb(0)=2
  336.     its=0
  337.     ResetTimer
  338.   EndIf
  339.  
  340.   If PrefDisplayBuffering>1
  341.     buf+1
  342.     If buf=PrefDisplayBuffering Then buf=0
  343.   EndIf
  344.  
  345.   LandX.w=SMouseX*xmult
  346.   LandY=SMouseY*ymult
  347.   LandX=Min(LandX,ILBMWid-PrefDisplayWidth)
  348.   LandY=Min(LandY,ILBMHig-PrefDisplayHeight)
  349.  
  350.   If IsAGA
  351.     Mc2p MBitmapPtr(LandX,LandY),PlanarBuf(buf)
  352.     ShowBitMap buf
  353.   Else
  354.     *ScrVP\DyOffset=buf*PrefDisplayHeight
  355. ;    *Ras\RyOffset=buf*PrefDisplayHeight
  356.     ScrollVPort_ *ScrVP
  357.     *RP._RastPort=RastPort(buf)
  358. ;    If ExecVersion<40
  359. ;      MBlockScroll LandX,LandY,PrefDisplayWidth,PrefDisplayHeight,0,0,0
  360. ;      If LandX MOD 16>0
  361. ;        MScroll PrefDisplayWidth+(LandX AND $FFF0),LandY,LandX MOD 16,PrefDisplayHeight,PrefDisplayWidth,0,0
  362. ;      EndIf
  363. ;      WritePixelArray8_ *RP,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(LandX MOD 16,0,1),0
  364. ;;      For Y=0 To PrefDisplayHeight-1
  365. ;;        WritePixelLine8_ *RP,0,Y,PrefDisplayWidth-1,MBitmapPtr(LandX,LandY+Y,0),0
  366. ;;      Next Y
  367. ;    Else
  368. ;      WriteChunkyPixels_ *RP,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(LandX,LandY,0),ILBMWid
  369. ;    EndIf
  370. MUseBitmap 10
  371. MBlockScroll LandX,LandY,PrefDisplayWidth,PrefDisplayHeight,0,0,0
  372.   EndIf
  373.  
  374.   its+1
  375. Wend
  376. t=Timer
  377. t=Max(t,1)
  378. its=Max(its,1)
  379. a.q=50.0/(t/its)
  380. WBenchToFront_
  381. VWait 20
  382. FindScreen 1
  383. Window 2,16,16,500,100,0,"Test results",1,0
  384. WindowOutput 2
  385. NPrint a," frames per second"
  386. NPrint " "
  387. NPrint "Press mouse/joy button..."
  388. Repeat
  389. Until Joyb(0)<>0 OR Joyb(1)<>0
  390.  
  391. Finish:
  392. Multitasking{On}
  393. End
  394.  
  395.  
  396.